File descriptions

• Kaggle_Halloween_train.csv - the training set
• Kaggle_Halloween_test.csv - the test set

Data fields

• id - id of the creature
• bone_length - average length of bone in the creature, normalized between 0 and 1
• rotting_flesh - percentage of rotting flesh in the creature
• hair_length - average hair length, normalized between 0 and 1
• has_soul - percentage of soul in the creature
• color - dominant color of the creature: ‘white’,‘black’,‘clear’,‘blue’,‘green’,‘blood’
• type - target variable: ‘Ghost’, ‘Goblin’, and ‘Ghoul’

Characters to Factors

Changer character strings to factors.

head(select_if(full,is.character))

##    color   type Dataset
## 1: clear  Ghoul   train
## 2: green Goblin   train
## 3: black  Ghoul   train
## 4: black  Ghoul   train
## 5: green  Ghost   train
## 6: green Goblin   train

####Convert character to factors - use full so all data is treated the same
full <- full %>% mutate_if(is.character, as.factor)
str(full)

## 'data.frame':    900 obs. of  8 variables:
##  $ id           : int  0 1 2 4 5 7 8 11 12 19 ...
##  $ bone_length  : num  0.355 0.576 0.468 0.777 0.566 ...
##  $ rotting_flesh: num  0.351 0.426 0.354 0.509 0.876 ...
##  $ hair_length  : num  0.466 0.531 0.812 0.637 0.419 ...
##  $ has_soul     : num  0.781 0.44 0.791 0.884 0.636 ...
##  $ color        : Factor w/ 6 levels "black","blood",..: 4 5 1 1 5 5 6 4 3 6 ...
##  $ type         : Factor w/ 3 levels "Ghost","Ghoul",..: 2 3 2 2 1 3 3 2 1 1 ...
##  $ Dataset      : Factor w/ 2 levels "test","train": 2 2 2 2 2 2 2 2 2 2 ...

color, type and Dataset are not factors.

Data Visualizations

dataViz1 <- full %>% filter(Dataset == "train") %>% ggplot(aes(x = type, y = bone_length, fill = type)) + geom_boxplot() + xlab("Creature") + 
  ylab("Bone Length") + scale_fill_manual(values = c("#D55E00", "#0072B2", "#009E73"))

dataViz2 <- full %>% filter(Dataset == "train") %>% ggplot(aes(x = type, y = rotting_flesh, fill = type)) + geom_boxplot() + xlab("Creature") + 
  ylab("Percentage of Rotting Flesh") + scale_fill_manual(values = c("#D55E00", "#0072B2", "#009E73"))

dataViz3 <- full %>% filter(Dataset == "train") %>% ggplot(aes(x = type, y = hair_length, fill = type)) + geom_boxplot() + xlab("Creature") + 
  ylab("Hair Length") + scale_fill_manual(values = c("#D55E00", "#0072B2", "#009E73"))

dataViz4 <- full %>% filter(Dataset == "train") %>% ggplot(aes(x = type, y = has_soul, fill = type)) + geom_boxplot() + xlab("Creature") + 
  ylab("Percentage of Soul Present") + scale_fill_manual(values = c("#D55E00", "#0072B2", "#009E73"))

grid.arrange(dataViz1, dataViz2, dataViz3, dataViz4, ncol = 2)

p1 <- plot_ly(train, x = train$bone_length, y = train$rotting_flesh, z = train$has_soul, type = "scatter3d", mode = "markers", color=train$type)
p1

Plots by Color Distribution

Compare the use of color amongst the creatures.

ghost_color <- full %>% filter(Dataset == "train") %>% filter(type == 'Ghost') %>% group_by(color) %>% summarise(count = n())

dataViz5 <-  ggplot(ghost_color, aes(x = color, y = count, fill = color)) + geom_bar(stat = "identity") + 
  xlab("Color") + ylab("Number of Observations") +  ggtitle("Ghost Colors") +  scale_fill_manual(values = c("Black", "#D55E00", "#0072B2", "#F0E442", "#009E73", "#999999")) + 
  theme(panel.grid.minor = element_blank()) +   ylim(0, 50)

ghost_color <- full %>% filter(Dataset == "train") %>% filter(type == 'Ghoul') %>% group_by(color) %>% summarise(count = n())

dataViz6 <-  ggplot(ghost_color, aes(x = color, y = count, fill = color)) + geom_bar(stat = "identity") + 
  xlab("Color") + ylab("Number of Observations") +  ggtitle("Ghoul Colors") +  scale_fill_manual(values = c("Black", "#D55E00", "#0072B2", "#F0E442", "#009E73", "#999999")) + 
  theme(panel.grid.minor = element_blank()) +   ylim(0, 50)

ghost_color <- full %>% filter(Dataset == "train") %>% filter(type == 'Goblin') %>% group_by(color) %>% summarise(count = n())

dataViz7 <-  ggplot(ghost_color, aes(x = color, y = count, fill = color)) + geom_bar(stat = "identity") + 
  xlab("Color") + ylab("Number of Observations") +  ggtitle("Goblin Colors") +  scale_fill_manual(values = c("Black", "#D55E00", "#0072B2", "#F0E442", "#009E73", "#999999")) + 
  theme(panel.grid.minor = element_blank()) +   ylim(0, 50)

grid.arrange(dataViz5, dataViz6, dataViz7, ncol = 2)

Appears ghosts have shorter hair and fewer pieces of soul than ghouls and goblins, but otherwise are pretty close. Ghouls and goblins are going to be tricky to distinguish. Color doesn’t appear to help a whole lot as there seems to be a pretty even distribution to these multi-colored creatures. (Will likely remove this variable before modeling.)

Examine is there are any obvious correlations.

pairs(full[,2:5], col = full$type, labels = c("Bone Length", "Rotting Flesh", "Hair Length", "Soul"))

The pairs plot above is not too helpful. Try a more scholarly approach below.

train_correlation <- train %>% select(bone_length:has_soul)
train_correlation <- cor(train_correlation)
# corrplot(train_correlation, method="circle")

# data 
corrplot::corrplot.mixed(train_correlation)

#cor(train_correlation)

No strong evidence of correlation - largest value is close to 0.5. Perhaps we can take advantage of a combination of characteristics that do seem to show some promise: most notably “Hair Length” and “Soul”. Do we get any better separation among creatures if we combine these variables into one? By multiplying our variables together we should obtain better features to distinguish the classes.

separation1 <- full %>%  mutate(hair_soul = hair_length * has_soul) %>% filter(!is.na(type))

ggplot(separation1, aes(x = type, y = hair_soul, fill = type)) + geom_boxplot() + 
  xlab("Creature") + ylab("Combination of Hair/Soul") + scale_fill_manual(values = c("#D55E00", "#0072B2", "#009E73"))

Separation appears greater. Test various other data mutations to determine if this can be improved furthere. This is a process of experimentation.

# Sep1
separation2 <- full %>% filter(!is.na(type)) %>% mutate(sep2 = bone_length * hair_length * has_soul, sep2 = sep2 / max(sep2))

separation3 <- full %>% filter(!is.na(type)) %>% mutate(allfeatures = ((bone_length^2) * (hair_length^4) * (has_soul^4))/rotting_flesh)

separation4 <- full %>% filter(!is.na(type)) %>% mutate(bone_flesh = bone_length * rotting_flesh, bone_hair = bone_length * hair_length,
                 bone_soul = bone_length * has_soul, flesh_hair = rotting_flesh * hair_length, flesh_soul = rotting_flesh * has_soul, 
                 hair_soul = hair_length * has_soul)

plotExp2 <- ggplot(separation2, aes(x = type, y = sep2, fill = type)) + geom_boxplot() + 
  xlab("Creature") + ylab("Combination of Bone-Hair-Soul") + ggtitle("Bone-Hair-Soul") + scale_fill_manual(values = c("#D55E00", "#0072B2", "#009E73"))

plotExp3 <- ggplot(separation3, aes(x = type, y = allfeatures, fill = type)) + geom_boxplot() + 
  xlab("Creature") + ylab("Combination of allfeatures") + ggtitle("All Features") + scale_fill_manual(values = c("#D55E00", "#0072B2", "#009E73"))

#separation 9 - 14 are the new variable columns
for(i in 9:14){
  # print(ggplot(separation4, aes(x = type, y = separation4[i], fill = type)) + geom_boxplot() + 
  # xlab("Creature") + ylab("Combination of allfeatures") + ggtitle(paste(names(separation4)[i])) + scale_fill_manual(values = c("#D55E00", "#0072B2", "#009E73")))
  
  assign(paste0("plotSep", i),ggplot(separation4, aes(x = type, y = separation4[i], fill = type)) + geom_boxplot() + 
  xlab("Creature") + ylab("Combos") + ggtitle(paste(names(separation4)[i])) + scale_fill_manual(values = c("#D55E00", "#0072B2", "#009E73")))
}
grid.arrange(plotSep9, plotSep10, plotSep11, plotSep12, plotSep13, ncol = 2)

Because separation apprears to be improved by combining variables, will likely use this for modeling later in the example.

Clustering data

While clustering is generally used for unsupervised machine learning, take a peek at the clusters that could be formed. The potential issue with trying to cluster this data is that we are working with two types of data: continuous and categorical. They break down like this:

There are only two categorical variables. Because of our small sample size, it’s not a good idea to count out these variables completely, but we’ll try to create clusters without them just to see how well the clustering models do.

# Set the seed
set.seed(1234)

# Extract creature labels and remove column from dataset
creature_labels <- full$type
full2 <- full
full2$type <- NULL

# Remove categorical variables (id, color, and dataset) from dataset
full2$id <- NULL
full2$color <- NULL
full2$Dataset <- NULL

# Perform k-means clustering with 3 clusters, repeat 30 times
creature_km_1 <- kmeans(full2, 3, nstart = 30)

dunn_ckm_1 <- dunn(clusters = creature_km_1$cluster, Data = full2)
dunn_ckm_1

## [1] 0.0425

table(creature_km_1$cluster, creature_labels)

##    creature_labels
##     Ghost Ghoul Goblin
##   1     3    95     35
##   2   106     5     20
##   3     8    29     70

full  <- full %>% mutate(bone_flesh = bone_length * rotting_flesh, bone_hair = bone_length * hair_length,
                 bone_soul = bone_length * has_soul, flesh_hair = rotting_flesh * hair_length, flesh_soul = rotting_flesh * has_soul, 
                 hair_soul = hair_length * has_soul)

train_complete <- filter(full, Dataset == "train")
train_complete <- select(train_complete, c(-id, -color, -Dataset))

test_complete <- filter(full, Dataset == "test")
test_complete <- select(test_complete, c(-id, -color, -Dataset))

myControl <- trainControl(method = "repeatedcv", number = 6, repeats = 10, verboseIter = TRUE)#repeatedcv vs cv - test and compare

set.seed(1234)
modelrandomforest <- train(type~., tuneLength = 3, data = train_complete, method = "ranger", trControl = myControl, importance = 'impurity')

set.seed(1234)
modelglm <- train(type~., method = "glmnet", tuneGrid = expand.grid(alpha = 0:1, lambda = seq(0.0001, 1, length = 20)), 
                       data = train_complete, trControl = myControl)

set.seed(1234)
# train LVQ model (Learning Vector Quantization)
modelLvq <- train(type~., data = train_complete, method="lvq", trControl = myControl)
# train Support Vector Machine model
modelSvm <- train(type~., data = train_complete, method="svmRadial", trControl = myControl)
# decision tree
modeltree <- train(type~., data = train_complete, method="rpart", trControl = myControl)
# Tree + PCA
modeltreepca <- train(type~., data = train_complete, method="rpart", trControl = myControl, preProcess = "pca", parms = list(split='information'))
# KNN
modelknn <- train(type~., data = train_complete, method="knn", trControl = myControl)
# Naive Bayes
modelbayes <- train(type~., data = train_complete, method="nb", trControl = myControl)

library("rpart.plot")
fit2 <- rpart(type~., method = "class", data = train_complete, control = rpart.control(minsplit = 50), parms = list(split='information'))
rpart.plot(fit2, type=2, extra = 1)

Comparing Models

Compare the results of all the models.

# Create a list of models
models <- list(Random_Forest = modelrandomforest, GLM = modelglm, LVQ = modelLvq, SVM = modelSvm, DecisionTree = modeltree, 
               DecisionTree_PCD = modeltreepca, NaiveBayes = modelbayes, KNN = modelknn, NaiveBayes = modelbayes)
               
# Resample the models
resampled <- resamples(models)
# Generate a summary
summary(resampled)

## 
## Call:
## summary.resamples(object = resampled)
## 
## Models: Random_Forest, GLM, LVQ, SVM, DecisionTree, DecisionTree_PCD, NaiveBayes, KNN, NaiveBayes 
## Number of resamples: 60 
## 
## Accuracy 
##                   Min. 1st Qu. Median  Mean 3rd Qu.  Max. NA's
## NaiveBayes       0.629   0.694  0.726 0.734   0.764 0.871    0
## Random_Forest    0.619   0.687  0.742 0.733   0.774 0.873    0
## GLM              0.617   0.726  0.758 0.758   0.806 0.873    0
## LVQ              0.597   0.676  0.718 0.719   0.762 0.850    0
## SVM              0.583   0.672  0.710 0.706   0.738 0.836    0
## DecisionTree     0.541   0.602  0.626 0.630   0.661 0.733    0
## DecisionTree_PCD 0.516   0.661  0.702 0.695   0.738 0.806    0
## KNN              0.623   0.710  0.742 0.742   0.774 0.839    0
## 
## Kappa 
##                   Min. 1st Qu. Median  Mean 3rd Qu.  Max. NA's
## NaiveBayes       0.441   0.541  0.588 0.601   0.645 0.806    0
## Random_Forest    0.430   0.530  0.613 0.599   0.661 0.810    0
## GLM              0.425   0.589  0.638 0.637   0.709 0.809    0
## LVQ              0.396   0.514  0.577 0.578   0.642 0.775    0
## SVM              0.371   0.508  0.564 0.557   0.606 0.754    0
## DecisionTree     0.311   0.400  0.441 0.445   0.493 0.600    0
## DecisionTree_PCD 0.262   0.491  0.551 0.541   0.605 0.709    0
## KNN              0.434   0.564  0.613 0.613   0.661 0.757    0

# Plot the differences between model fits
dotplot(resampled, metric = "Accuracy")

Learning Vector Quantization (LVQ)

(Added this because it was recently learned.) Learning vector quantization (LVQ) is an algorithm that is a type of artificial neural networks and uses neural computation. More broadly, it can be said to be a type of computational intelligence. This algorithm takes a competitive, winner-takes-all approach to learning and is also related to other neural network algorithms like Perceptron and back-propagation. The LVQ algorithm allows one to choose the number of training instances to undergo and then learns about what those instances look like. LVQ is related to the k-nearest neighbor algorithm.